home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 8: LINUX Games / Linux Cubed Series 8 - LINUX Games.iso / games / x11 / rpg / crossfir.92 / crossfir / crossfire-0.92.5 / lib / adm / map_info < prev    next >
Text File  |  1996-07-24  |  7KB  |  264 lines
  1. #!/usr/local/bin/perl
  2. #
  3. # This program is meant to use check crossfire (version 0.90.?) maps.
  4. # Program wanderers through mapfiles and reports all objects that 
  5. # can't be found in the archetypes, all exit that doesn't lead to
  6. # anywhere and all corrupted mapfiles.
  7. #
  8. # By: Tero Haatanen <Tero.Haatanen@lut.fi>
  9. #
  10. # Usage: wanderer.pl directory
  11.  
  12. $LIB   = "/home/sleipner/a/tars/crossfire/lib";
  13. $ARCH  = "$LIB/archetypes";
  14. $MAPS  = "$LIB/maps";
  15.  
  16. if (! $ARGV[0]) {
  17.     print "Usage: wanderer.pl map-directory ... > output.log\n";
  18.     exit;
  19. }
  20.  
  21. # read filenames to @maps
  22. chdir ($MAPS);
  23. while ($area = shift) {
  24.     &maplist ($area);
  25. }
  26.  
  27. $* = 1;                # use multiline matches
  28.  
  29. # read archetypes
  30. &archetypes;
  31. %ex = &collect ('^type 66$');        # type 66 == exit
  32. %tele = &collect ('^type 41$');        # type 41 == teleport
  33. %conn = &collect ('^type (17|18|26|27|29|30|31|32|91|92|93|94)$');
  34. delete $conn{"spikes_moving"};
  35. delete $conn{"magic_ear"};
  36. %players = &collect ('^type 1$');    # type 1 == player
  37.  
  38. # check exits from archetypes
  39. foreach $a (keys (%ex), keys (%tele)) {
  40.     if ($arches {$a} =~ /^food -?\d+$/) {
  41.     print "Warning: Archetype $a has food field.\n";
  42.     }
  43. }
  44.  
  45. # some general info
  46. print "=" x 70, "\n";
  47. print "Number of mapfiles = " , @maps + 0, "\n";
  48. print "Number of archetypes = " , values(%arches)+0, ":\n";
  49. print " - Exits ("            , values(%ex)+0,      ")\n";
  50. print " - Teleports ("        , values(%tele)+0,    ")\n";
  51. print " - Connected objects (", values(%conn)+0,    ")\n";
  52. print " - Players ("          , values(%players)+0, ")\n";
  53. print "=" x 70, "\n";
  54.  
  55. # check maps
  56. while ($file = shift (@maps)) {
  57.     &readmap;
  58. }
  59.  
  60. # summary of missing archetypes 
  61. if (%missing) {
  62.     print "=" x 70, "\n";
  63.     print "Missing archetypes: ", join (", ", sort keys (%missing)), "\n";
  64. }
  65. # if you don't want list of used objects, uncomment next line
  66. # and you can comment also last line check_obj
  67. # (This isn't very useful, but maybe tells something)
  68.  
  69. exit;
  70.  
  71. print "=" x 70, "\nArchetype               count\n";
  72. $total = 0;
  73. foreach $a (sort by (keys (%objects))) {
  74.     printf ("%-24s%d\n", $a, $objects{$a});
  75.     $total +=  $objects{$a};
  76. }
  77. print '-' x 30, "\nTotal objects           $total\n";
  78. exit;
  79.  
  80. # return table containing all objects in the map
  81. sub readmap {
  82.     local ($m);
  83.     $last = "";
  84.     
  85.     $/ = "\nend\n";
  86.     if (! open (IN, $file)) {
  87.     print "Can't open map file $file\n";
  88.     return;
  89.     }
  90.     $_ = <IN>;
  91.     if (! /^arch map$/) {
  92.     print "Error: file $file isn't mapfile.\n";
  93.     return;
  94.     }
  95.     print "Testing $file, ";
  96.     print /^name (.+)$/ ? $1 : "No mapname";
  97.     print ", size [", /^x (\d+)$/ ? $1 : 16;
  98.     print ",", /^y (\d+)/ ? $1 : 16, "]";
  99.  
  100.     if (! /^msg$/) {
  101.     print ", No message\n";
  102.     } elsif (/(\w+@\S+)/) {
  103.     print ", $1\n";
  104.     } else {
  105.     print ", Unknown\n";
  106.     }
  107.  
  108.     while (<IN>) {
  109.     if (($m = (@_ = /^arch \S+$/g)) > 1) {
  110.         # object has inventory
  111.         local ($inv) = $_;
  112.         while (<IN>) {
  113.         if (/((.|\n)*end\n)(arch (.|\n)*\nend\n)/) {
  114.             &check_obj ("$inv$1");
  115.             &check_obj ($3);
  116.             last;
  117.         } elsif (/^arch (.|\n)*\nend$/) {
  118.             &check_obj ($_);
  119.         } elsif (/^end$/) {
  120.             &check_obj ("$inv$_");
  121.         } else {
  122.             print "  Error: Corrupted map file $file.\nSegment:\n$_\nLine: $.\n";
  123.         }
  124.         } 
  125.     } elsif (/^More$/ || $m == 1) {
  126.         &check_obj ($_);
  127.     } else {
  128.         print "  Error: Corrupted map file $file.\nSegment:\n$_\nLine: $.\n"; 
  129.     }
  130.     }
  131.     close (IN);
  132. }
  133.  
  134. sub check_obj {
  135.     $_ = shift @_;
  136.  
  137.     local ($x) = (/^x (\d+)$/)?$1:0;
  138.     local ($y) = (/^y (\d+)$/)?$1:0;
  139.     local($arch) = /^arch (\S+)$/;
  140.  
  141.     if (! $arches{$1} && $last ne $1) {
  142.     $last = $1;
  143.     print "  Error: Object $last is not defined in archetypes file ($x,$y)\n"; 
  144.     $missing{$last}++;
  145.     } elsif ($ex{$1}) {
  146.     &examine_exit ($_);
  147.     } elsif ($tele{$1}) {
  148.     if (/^food -?\d+$/) {
  149.         print "  Error: Teleport $1 has food field.\n";
  150.     }
  151.     else {
  152.         &examine_exit ($_);
  153.     }
  154.     } elsif ($conn{$1} && ! /^connected -?\d+$/) {
  155.     $last = $1;
  156.     print "  Warning: Object $last has not been connected, $x,$y\n";
  157.     } elsif ($players{$1} && $last ne $1 && ! /^type / ) {
  158.     $last = $1;
  159.     print "  Error: Player $last found in the map.\n";
  160.     } elsif ($1 eq "scroll" && ! /^msg$/) {
  161.     $last = $1;
  162.     print "  Warning: scroll without message ($x, $y), should be random_scroll?\n";
  163.     } elsif ($1 eq "potion" && $last ne $1) {
  164.     $last = $1;
  165.     print "  Warning: potion found, should be random_potion or random_food?\n";
  166.     } elsif ($1 eq "ring" || $1 eq "amulet") {
  167.     $last = $1;
  168.     print "  Warning: ring/amulet found ($x,$y), should be random_talisman?\n";
  169.     } elsif (/^color_fg (\S+)$/ || /^color_bg (\S+)$/) {
  170.     $last = $arch;
  171.     print "  Warning:  Object ".$arch." is setting color ($1), $x,$y\n";
  172.     }
  173.     $objects{$1}++;
  174. }
  175.  
  176. sub by {
  177.      $_ = $objects{$b} <=> $objects{$a};
  178.      $_ ? $_ : $a cmp $b;
  179. }
  180.  
  181. sub obj_name {
  182.     $_  = shift(@_);
  183.     local ($name) =  /^name (.+)$/;            # object's name
  184.     local ($arch) =  /^arch (\S+)$/;
  185.     if (!defined ($name) && $arches{$arch} =~ /^name (.+)$/) {
  186.     $name = $1;                    # archetype's name
  187.     }
  188.     return defined ($name) ? $name : $arch;        # archetype or name
  189. }
  190.  
  191. sub examine_exit {
  192.     $_  = shift(@_);
  193.  
  194.     local ($x) = (/^hp (\d+)$/)?$1:0;
  195.     local ($y) = (/^sp (\d+)$/)?$1:0;
  196.     local ($x1) = (/^x (\d+)$/)?$1:0;
  197.     local ($y1) = (/^y (\d+)$/)?$1:0;
  198.     local ($to) = /^slaying (\S+)$/;
  199.  
  200.     if (/^food (-?\d+)$/) {
  201.     # old style exits, doesn't work with crossfire 0.90-1
  202.     print  " Error: ", &obj_name($_), " ($x1,$y1) -> ", 
  203.           "Old style level [$1] ($x,$y)\n";
  204.     } elsif (! defined ($to)) {
  205. #    print "  Closed: ", &obj_name($_), " ($x1,$y1)\n";
  206.     } else {
  207.     # These are currently used be crossfire
  208.     if ($to =~ m!^/!) {
  209.         $cdir = "$MAPS";
  210.     } else {
  211.         ($cdir) = $file =~ m!(.*/)!;
  212.     }
  213.     if (! -f "$cdir$to") {
  214.         print "  Missing: ", &obj_name($_), " ($x1,$y1) -> $to ($x,$y)\n";
  215.     } else {
  216. #        print "  OK: ", &obj_name($_), " ($x1,$y1) -> $to ($x,$y)\n";
  217.     }
  218.     }
  219. }
  220.  
  221. # @maps contains all filenames
  222. sub maplist {
  223.     local ($dir, $file, @dirs) = shift;
  224.  
  225.     opendir (DIR , $dir) || die "Can't open directory : $dir\n";
  226.     while ($file = readdir (DIR)) {
  227.     next if ($file eq "." || $file eq "..");
  228.     $file = "$dir/$file";
  229.     push (@dirs, $file) if (-d $file);
  230.     push (@maps, $file) if (-f $file);
  231.     }
  232.     closedir (DIR);
  233.  
  234.     # recurcive handle sub-dirs too
  235.     while ($_ = shift @dirs) {
  236.     &maplist ($_);
  237.     }
  238. }
  239.  
  240. # collect all objects matching with reg.expr.
  241. sub collect {
  242.     local ($expr,$a, %col) = shift;
  243.  
  244.     foreach $a (keys %arches) {
  245.     $_ = $arches{$a};
  246.     if (/$expr/) {
  247.         $col{$a}++;
  248.     }
  249.     }
  250.     return %col;
  251. }
  252.  
  253. # collect all archetypes into associative array %arches
  254. sub archetypes {
  255.     open (IN, $ARCH) || die "Can't open achetype file $ARCH.\n";
  256.     $/ = "\nend\n";
  257.     while (<IN>) {
  258.     if (/^Object (\S+)$/) {
  259.         $arches{$1} = $_;
  260.     }
  261.     }
  262.     close (IN);
  263. }
  264.